home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / pcpm.arc / CPASBC.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  2.8 KB  |  90 lines
  1. 20  CLOSE
  2. 100  KEY OFF
  3. 112  T1$="Project: \                                                 \ File: \          \"
  4. 113  T2$="Time Period Units: \             \  Sub/Comment Codes: ##   Start Date: \    \ "
  5. 115  W6$="## \      \ ## \      \ ## \      \"
  6. 120  DIM S$(48)
  7. 140  GOSUB 5000:GOTO 4800
  8. 200  CLS:GOSUB 5500:GOSUB 6000
  9. 210  LOCATE 7,1:PRINT "                                        "
  10. 211  LOCATE 9,1:PRINT "                                        ":LOCATE 5,38:PRINT "   "
  11. 212  LOCATE 5,1:PRINT "Add,Change,Delete,or Quit (A/C/D/Q) ";:COLOR 15,0:INPUT Q$:COLOR 7,0
  12. 220  IF Q$="Q" THEN 3000
  13. 230  IF Q$="A" THEN 500
  14. 240  IF Q$="C" THEN 1000
  15. 250  IF Q$="D" THEN 2000
  16. 260  BEEP:GOTO 210
  17. 500  I=NSBC
  18. 510  I=I+1:IF I>48 THEN PRINT:PRINT "**** MAXIMUM IS 48 ****":BEEP:FOR I=1 TO 750:KR$="KRISTY":NEXT:GOTO 210
  19. 520  LOCATE 7,1:PRINT "Enter Subcontractor/Comment (or Q) ":COLOR 15,0:LOCATE 9,1:PRINT I;"  __________":LOCATE 9,5:INPUT S$(I):COLOR 7,0
  20. 525  IF S$(I)="Q" THEN NSBC=I-1:S$(I)="":GOTO 610
  21. 530  GOSUB 540:GOTO 590
  22. 540  COLOR 15,0
  23. 542  IF I<17 THEN TB=47:L=I+4
  24. 544  IF I>16 AND I<33 THEN TB=59:L=I-16+4
  25. 546  IF I>32 THEN TB=71:L=4+I-32
  26. 550  LOCATE L,TB:PRINT S$(I)
  27. 560  COLOR 7,0
  28. 570  RETURN
  29. 590  IF I=48 THEN NSBC=48:GOTO 610
  30. 600  GOTO 510
  31. 610  GOSUB 6000:GOTO 210
  32. 1000  REM CHANGE SUBCONTRACTOR ACTIVITY
  33. 1010  LOCATE 7,1:INPUT "Enter Code Number (or 0) ";I
  34. 1015  IF I=0 THEN 210
  35. 1020  GOSUB 540
  36. 1030  LOCATE 9,1:INPUT "Enter New Name/Comment ",S$(I)
  37. 1034  LOCATE L,TB:PRINT "        "
  38. 1035  LOCATE L,TB:PRINT S$(I):LOCATE 7,27:PRINT "    ":LOCATE 9,24:PRINT "         "
  39. 1038  LOCATE 9,1:PRINT "                                        "
  40. 1040  GOTO 1010
  41. 2000  REM delete subcontractor
  42. 2010  LOCATE 7,1:INPUT "Enter Code number or 0 to exit ",I
  43. 2015  IF I=0 THEN 210
  44. 2020  GOSUB 540
  45. 2025  S$(I)="        "
  46. 2027  LOCATE 7,31:PRINT "      "
  47. 2030  LOCATE L,TB:PRINT "        ":BEEP:GOTO 2010
  48. 3000  LOCATE 7,1:INPUT "File Changes or Quit (F/Q) ",Q$
  49. 3010  IF Q$="Q" THEN 3500
  50. 3020  IF Q$<>"F" THEN BEEP:GOTO 3000
  51. 3030  OPEN F$+".SBC" FOR OUTPUT AS #1
  52. 3040  FOR I=1 TO NSBC
  53. 3050  PRINT #1,S$(I)
  54. 3060  NEXT
  55. 3070  CLOSE #1
  56. 3500  CLS:CHAIN "CPAMENU"
  57. 4800  ON ERROR GOTO 4880
  58. 4805  OPEN F$+".SBC" FOR INPUT AS #1
  59. 4810  I=0:NMISS=0
  60. 4820  I=I+1
  61. 4830  IF EOF(1) THEN 4860
  62. 4835  IF I=49 THEN 4860
  63. 4840  INPUT #1,S$(I)
  64. 4845  IF S$(I)="" OR S$(I)="        " THEN NMISS=NMISS+1
  65. 4850  GOTO 4820
  66. 4860  REM
  67. 4865  NSBC=I-1
  68. 4868  CLOSE #1
  69. 4870  GOTO 200
  70. 4880  PRINT "**** NO SUBCONTRACTOR FILE - CONTINUING ****":NEWSBC=1:RESUME 200
  71. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  72. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  73. 5015  IF G$="Q" OR G$="QUIT" THEN 3500
  74. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  75. 5030  IF LEN(F$)>8 THEN PRINT "NOT A VALID PCPM FILE - MUST END IN .CPM OR .SRT":BEEP:GOTO 5010
  76. 5035  ON ERROR GOTO 5300
  77. 5037  G$=F$+".CPM"
  78. 5040  OPEN G$ FOR INPUT AS #3
  79. 5050  INPUT #3,P$,T6$,DA$
  80. 5140  M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  81. 5150  CLOSE #3
  82. 5160  PRINT " **** INPUT FILE READ ****"
  83. 5170  RETURN
  84. 5300  PRINT "**** NEW FILE ****":RESUME 4800
  85. 5500  CLS:COLOR 15,0,0:PRINT USING T1$;P$,G$:PRINT USING T2$;T6$,NSBC,DA$:COLOR 7,0,0:RETURN
  86. 6000  REM PRINT SUBCONTRACTOR CODES TO RIGHT OF INPUT SCREEN
  87. 6005  LOCATE 4,49:COLOR 15,0:PRINT "SUBCONTRACTOR/COMMENT CODES":COLOR 7,0
  88. 6010  FOR I=1 TO 16:LOCATE I+4,44:PRINT USING W6$;I,S$(I),I+16,S$(I+16),I+32,S$(I+32):NEXT I
  89. 6020  RETURN
  90.